home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TSR.SWG / 0003_Clock ISR unit.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  105 lines
  1. {I have made some changes in your Unit Check, in order to make ik a bit faster
  2. and use somewhat less code and data space (61 Bytes in all). Also, the display
  3. of progress on screen is now 'ticking' because I swap the colors from white on
  4. blue to gray on blue (perhaps a nice idea, now you can see if the machine
  5. Really crashed)...
  6. }
  7. {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,R-,S+,V-,X-}
  8. {$M 8192,0,655360}
  9. {$DEFINE COLOR}
  10. Unit MyCheck;
  11. {
  12.              TeeCee     Bob Swart  Saved:
  13.   Code size: 514 Bytes  455 Bytes  59 Bytes
  14.   Data size:  32 Bytes   30 Bytes   2 Bytes
  15.  
  16.   Here is the $1C ISR that I will add (unless you wish to do that).
  17.  
  18.   Some changes were made, which resulted in less code and data size, a
  19.   little more speed, and display of the progress Variable on screen is
  20.   made 'ticking' each second by changing the colour from white on blue
  21.   to gray on blue and back With each update.
  22. }
  23. Interface
  24.  
  25. Var progress: LongInt Absolute $0040:$00F0;
  26.  
  27. Implementation
  28. { Everything is private to this Unit }
  29. Uses Dos;
  30.  
  31. Const
  32.   Line      = 0;    { Change as required For position of display on screen }
  33.   Column    = 72;                                 { Top left corner is 0,0 }
  34.   ScreenPos = (line * 80 * 2) + (column * 2);
  35.   Colour: Byte = $1F;                                 { White/Gray on Blue }
  36.  
  37. Type
  38.   TimeStr = Array[0..15] of Char;
  39.   TimePtr = ^TimeStr;
  40.  
  41. Var
  42.   {$IFDEF COLOR}
  43.   Time: TimeStr Absolute $B800:ScreenPos;  { Assume colour display adaptor }
  44.   {$ELSE}
  45.   Time: TimeStr Absolute $B000:ScreenPos; { Otherwise mono display adaptor }
  46.   {$endIF}
  47.   OldInt1C: Pointer;
  48.   ExitSave: Pointer;
  49.  
  50.  
  51. {$F+}
  52. Procedure Int1CISR; Interrupt;
  53. { This will be called every clock tick by hardware interrupt $08 }
  54. Const DisplayTickCount = 20;
  55.       TickCount: LongInt = DisplayTickCount;
  56.       HexChars: Array[$0..$F] of Char = '0123456789ABCDEF';
  57. Var HexA: Array[0..3] of Byte Absolute progress;
  58. begin
  59.   Asm
  60.     cli
  61.   end;
  62.   inc(TickCount);
  63.   if TickCount > DisplayTickCount then { ticks to update the display }
  64.   begin
  65.     TickCount := 0;        { equality check and assignment faster than mod }
  66.             { The following statements actually display the on-screen time }
  67.     Colour := Colour xor $08;        { Swap between white and gray on blue }
  68.     FillChar(Time[1],SizeOf(Time)-1,Colour);
  69.     Time[00] := HexChars[HexA[3] SHR 4];
  70.     Time[02] := HexChars[HexA[3] and $F];
  71.     Time[04] := HexChars[HexA[2] SHR 4];
  72.     Time[06] := HexChars[HexA[2] and $F];
  73.     Time[08] := HexChars[HexA[1] SHR 4];
  74.     Time[10] := HexChars[HexA[1] and $F];
  75.     Time[12] := HexChars[HexA[0] SHR 4];
  76.     Time[14] := HexChars[HexA[0] and $F]
  77.   end { if TickCount > DisplayTickCount };
  78.   Asm
  79.     sti
  80.     pushf                                  { push flags to set up For IRET }
  81.     call  OldInt1C                              { Call old ISR entry point }
  82.   end
  83. end {Int1CISR};
  84. {$F-}
  85.  
  86.  
  87. Procedure ClockExitProc; Far;
  88. { This Procedure is VERY important as you have hooked the timer interrupt  }
  89. { and therefore if this is omitted when the Unit is terminated your        }
  90. { system will crash in an unpredictable and possibly damaging way.         }
  91. begin
  92.   ExitProc := ExitSave;
  93.   SetIntVec($1C,OldInt1C);               { This "unhooks" the timer vector }
  94. end {ClockExitProc};
  95.  
  96.  
  97. begin
  98.   progress := 0;
  99.   ExitSave := ExitProc;                          { Save old Exit Procedure }
  100.   ExitProc := @ClockExitProc;                 { Setup a new Exit Procedure }
  101.   GetIntVec($1C,OldInt1C);              { Get old timer vector and save it }
  102.   SetIntVec($1C,@Int1CISR);   { Hook the timer vector to the new Procedure }
  103. end.
  104.  
  105.